# CCN::Database.pm
# Copyright (C) 2006  Stephane Alnet
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 3
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
# 

# This file is part of the CarrierClass.net project.
# For more information, consult http://carrierclass.net/

use strict; use warnings;

package CCN::Database;
use base qw(CCN::Class);
use DBI;

sub initialize
{
    my $self = shift;
    $self->{db} = shift;
    $self->{login} = shift;
    $self->{password} = shift;

    $self->{dbh} = $self->connect_database()
        or $self->dbh_die('connect '.$self->{db});
}

sub is_connected
{
    my $self = shift;
    return exists $self->{'dbh'} and defined $self->{'dbh'};
}

sub DESTROY()
{
    my $self = shift;
    $self->{dbh}->disconnect() if defined $self->{dbh};
    undef $self->{dbh};
    delete $self->{dbh};
}

sub connect_database()
{
    my $self = shift;
    my $dbh = DBI->connect(
        $self->{db}, $self->{login}, $self->{password}, 
        { RaiseError => 0, AutoCommit => 1 }
    )
        or $self->dbh_die("DBI_connect(".$self->{db}.")");
    return $dbh;
}

sub dbh_die
{
    my $self = shift;
    $self->die('dbh_die: '.(defined $self->{dbh} ? $self->{dbh}->errstr : $DBI::errstr),@_);
}

# Insert / Update

sub insert($$)
{
    my $self = shift;
    my ($table,$set) = @_;
    my @set = sort keys %{$set};
    my $sql = qq( INSERT INTO "$table" ).
              "(".join(', ', map { qq("$_") } @set).")".
              qq( VALUES ).
              "(".join(', ', map { qq(?) } @set).")".
              qq( ; );
    my $sth = $self->{dbh}->prepare($sql);
    $sth->execute( @{$set}{@set} )
        or $self->dbh_die($sql);
}

sub update($$$)
{
    my $self = shift;
    my ($table,$where,$set) = @_;
    my @where = sort keys %{$where};
    my @set   = sort keys %{$set};
    my $sql = qq( UPDATE "$table" ).
              qq( SET ).join(', ', map { qq("$_" = ?) } @set).
              qq( WHERE ).join(' AND ', map { qq("$_" = ?) } @where).
              qq( ; );
    my $sth = $self->{dbh}->prepare($sql);
    $sth->execute(
        @{$set}{@set}, 
        @{$where}{@where}
    )
        or $self->dbh_die($sql);
}

sub append($$$$)
{
    my $self = shift;
    my ($table,$rank_field,$where,$set) = @_;
    my @where = sort keys %{$where};
    my @set = sort keys %{$set};

    $self->{dbh}->begin_work();

    my $sql = 
        qq( INSERT INTO "$table" ).
        "(".join(', ', map { qq("$_") } (@where,@set,$rank_field)).",  )".
        qq( VALUES ).
        "(".join(', ', map { qq(?) } (@where,@set)).", ".
            "(".
            qq( SELECT COUNT(*)+1 FROM "$table" ).
            qq( WHERE ).join(' AND ', map { qq("$_" = ?) } @where).
            ")".
        ")".
        qq( ; );
    
    my $sth = $self->{dbh}->prepare($sql);
    my @val_set = @{$set}{@set};
    $sth->execute(
        @{$where}{@where},
        @{$set}{@set},
        @{$where}{@where},
    )
        or $self->dbh_die($sql);
    
    $self->{dbh}->commit();
}

# Select

sub count($$)
{
    my $self = shift;
    my ($table,$where) = @_;
    my @where = sort keys %{$where};
    
    my $sql = 
        qq( SELECT COUNT(*) FROM "$table" ).
        qq( WHERE ).join(' AND ', map { qq("$_" = ?) } @where).
        qq( ; );
    my $sth = $self->{dbh}->prepare($sql);
    $sth->execute( @{$where}{@where} )
        or $self->dbh_die($sql);

    my $row_ary = $sth->fetchrow_arrayref;
    $sth->finish;
    return $row_ary->[0];
}

#
# $self->get('table','field1,filed2',{'where1'=>$value1,'where2'=>$value2});
#
sub _select
{
    my $self = shift;
    my ($table,$return_field,$where) = @_;
    my @where = sort keys %{$where};

    my $sql = 
        qq( SELECT "$return_field" FROM "$table" ).
        qq( WHERE ).join(' AND ', map { qq("$_" = ?) } @where).
        qq( AND ).join(' AND ', map { qq("$_" IS NOT NULL) } split(/,/,$return_field)).
        qq( ; );
    return $self->sql_do($sql, @{$where}{@where} );
}

#
# $self->sql_do('SELECT field1, field2 FROM table WHERE where1 = ? AND where2 = ?',$value1,$value2);
#
sub sql_do
{
    my $self = shift;
    my $sql = shift;
    
    my $sth = $self->{dbh}->prepare($sql)
        or $self->dbh_die("prepare '$sql'");
    $sth->execute(@_)
        or $self->dbh_die("execute '$sql'");
    return $sth;
}

#
# $self->sqlref_do('SELECT field1, field2 FROM table WHERE where1 = $where1 AND where2 = $where2',{'where1'=>$value1,'where2'=>$value2});
#
sub sqlref_do
{
    my $self = shift;
    my ($sql,$where) = @_;
    my @where = ($sql =~ /\$(\w+)/g);
    $sql =~ s/\$\w+/?/g;

    return $self->sql_do($sql, @{$where}{@where} );
}


# The three forms of "get"

sub get($$$)
{
    my $self = shift;
    my $sth = $self->_select(@_);

    my $row_ary = $sth->fetchrow_arrayref;
    $sth->finish;
    return undef if not defined $row_ary;
    return wantarray ? @{$row_ary} : $row_ary->[0];
}

sub sql_get
{
    my $self = shift;
    my $sth = $self->sql_do(@_);

    my $row_ary = $sth->fetchrow_arrayref;
    $sth->finish;
    return undef if not defined $row_ary;
    return wantarray ? @{$row_ary} : $row_ary->[0];
}

sub sqlref_get($$)
{
    my $self = shift;
    my $sth = $self->sqlref_do(@_);

    my $row_ary = $sth->fetchrow_arrayref;
    $sth->finish;
    return undef if not defined $row_ary;
    return wantarray ? @{$row_ary} : $row_ary->[0];
}

# The three forms of "get_array"

sub get_array($$$)
{
    my $self = shift;
    my $sth = $self->_select(@_);

    return map { $_->[0] } @{$sth->fetchall_arrayref([0])};
}

sub sql_get_array
{
    my $self = shift;
    my $sth = $self->sql_do(@_);

    return map { $_->[0] } @{$sth->fetchall_arrayref([0])};
}

sub sqlref_get_array($$$)
{
    my $self = shift;
    my $sth = $self->sqlref_do(@_);

    return map { $_->[0] } @{$sth->fetchall_arrayref([0])};
}

# The three forms of do_for

sub do_for
{
    my $self = shift;
    my $func = pop;
    my $sth = $self->_select(@_);

    while( my $row_ary = $sth->fetchrow_arrayref() )
    { $func->(@{$row_ary}); }
}

sub sql_do_for
{
    my $self = shift;
    my $func = pop;
    my $sth = $self->sql_do(@_);

    while( my $row_ary = $sth->fetchrow_arrayref() )
    { $func->(@{$row_ary}); }
}

sub sqlref_do_for
{
    my $self = shift;
    my $func = pop;
    my $sth = $self->sqlref_do(@_);

    while( my $row_ary = $sth->fetchrow_arrayref() )
    { $func->(@{$row_ary}); }
}

# Database populate from text file

sub inject($)
{
    my $self = shift;
    my ($file) = @_;

    open(my $fh, '<', $file) or $self->error("open($file): $!");
    my $sql = '';
    while(<$fh>)
    {
        chomp;
        s/--.*$//;
        next if /^\s*POPULATE/;

        $sql .= $_;

        if( /;\s*$/ )
        {
            $self->sql_do($sql);
            $sql = '';
        }
    }
}

# For populate*, "self" is the "POPULATE FROM" database
# (normally, the provisioning database) while "dbh_to" is
# the recipient database (normally, the dynamic mysql database).

sub populate($$$$)
{
    my $self = shift;
    my ($query_from,$dbh_to,$query_to) = @_;

    my @names = ($query_from =~ m/\$\w+/g);
    $query_from =~ s/(\$\w+)/?/g;

    my @values = map {
        exists $self->{$_} ? $self->{$_} :
        $self->die ("Invalid name in SQL POPULATE: $_")
    } @names;

    my $sth_from = $self->sql_do($query_from);

    my $sth_to = $dbh_to->prepare($query_to);
    while( my $row_ary = $sth_from->fetchrow_arrayref() )
    {
        $sth_to->execute(@{$row_ary}) or $self->dbh_die($query_to);
    }
}

# Note: when building the queries, remember that $server_name will generally
# be the name of the primary database server.

sub populate_into($$)
{
    my $self = shift;
    my ($dbh_to,$file) = @_;

    open(my $fh, '<', $file) or $self->error("open($file): $!");
    my $query_from = '';
    while(<$fh>)
    {
        chomp;
        s/--.*$//;
        next unless /^\s*POPULATE/;

        $query_from = $1, next
            if /^--#!\s*POPULATE\s*FROM\s*(\S.*)$/;

        $self->populate($query_from,$dbh_to,$1), next
            if /^--#!\s*POPULATE\s*INTO\s*(\S.*)$/;
    }
}

sub sql_begin()
{
    my $self = shift;
    $self->{dbh}->begin_work() or $self->dbh_die('begin work');
}

sub sql_commit()
{
    my $self = shift;
    $self->{dbh}->commit() or $self->dbh_die('commit');
}

sub sql_rollback()
{
    my $self = shift;
    $self->{dbh}->rollback() or $self->dbh_die('rollback');
}

sub last_insert_id()
{
    my $self = shift;
    return $self->{dbh}->last_insert_id('undef','undef','undef','undef');
}

1;
